MacHack 1993/MacHack 1993.toast/MacHack™ 1987-1992/MacHack™ '90/Source Code ƒ/Misc. Pascal ƒ/Jay's Cookie/Bake.p

Text File | 1990-06-15 | 11.4 KB | 433 lines | [TEXT/MPS ]

{[n+,u+,r+,d+,#+,j=13-/40/1o,t=2,o=95] PasMat formatting options}

{------------------------------------------------------------------------------

    Bake.p by D. Jay Newman;  I release this into the public domain


FILE Bake.p

NAME
    Bake -- converts a fortune cookie file from text to internal format

SYNOPSIS
    Bake inputFileName outputFileName

DESCRIPTION
    A pure unix-syle filter, which will convert the input file (which should be of
    type TEXT into the file format prefered by my fortune cookie DA).  The file
    format is as follows:
        Number of Cookies (n):            LONGINT;
        Text offsets of each cookie:    ARRAY [1..n] OF LONGINT
        Text offset of end of file:        LONGINT;
        Cookie Text:                    Text;    --Cookies are separated by 0's--

    The start of the text is calculated:
        (Number of Cookies + 2) * SizeOf (LONGINT)

    The offset of cookie i is
        (i * SizeOf (LONGINT))

    The length of cookie i is
        (Offset of cookie i) - (Offset of cookie i+1)

    Input File Format:
        A basic text file, if there is a RETURN at the end of the line, and the
        cookie is not ended, then the next line will be joined (the RETURN changed
        to a space), unless the next line begins with a non-alphanumeric character.
        Special lines are the following:
            %%    - End of cookie
            $$    - Skip this line (add a return here and at end of previous line)

MODIFICATIONS
    2/22/90
        Originally, I did all the temp stuff in memory.  Now I will use a temp
        file to store the text until I write it to the real file.
------------------------------------------------------------------------------}
{$R-}          { Turn off range checking}
PROGRAM Bake;

USES    { $Load macstuff}
    Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf, { Standard Includes}
    { $Load mpwstuff}
    CursorCtl,                        {for the spinning cursor}
    Signal,                         {to handle command-period}
    PasLibIntf,                     {for standard I/O, etc.}
    IntEnv;                         {for argV and argC}


TYPE
    LongPtr = ^LONGINT;

CONST
    Version            = '0.9.1';         {Current version}
    kCookieSize        = 20000;        {One big mama of a cookie!}
    kOffsetSize        = 100000;        {Up to 25,000 cookies!}

VAR
    textName:        Str255;            {the names of the files}
    realName:         Str255;            {name of output file}
    tempName:        Str255;            {name of temp file}
    quiet:            Boolean;         { True ==> no info on Diagnostic file}
    progName:        Str255;            { Program's file name}
    interrupted:    Boolean;        {True ==> interrupted (Opt "." pressed)}
    retCode:        (RC_Normal, RC_ParmErrs, RC_Abort); {Return codes}

    textCookies:        TEXT;                {This is a text file}
    realCookies:        FILE;                {This is an untyped file}
    tempCookies:        FILE;                {This is an untyped file, consisting
                                                of the modified cookie text, but
                                                not the offsets}
    cookieBuffer:        Handle;                {current formatted cookie}
    textLen:            LONGINT;            {length of formatted text}
    bufLen:                LONGINT;            {length of current cookie buffer}
    numCookies:            LONGINT;            {number of cookies formatted}
    curOffset:            LONGINT;            {offset of current cookie}
    prevOffset:            LONGINT;            {offset of previous cookie}
    theOffsets:            Handle;                {array of offsets: numCookies is number}
    addSpace:            BOOLEAN;            {FALSE only when $$ line found}

    {[j=0] PasMat formatting option}

    {*----------------------------------*
    | Stop - terminate execution        |
    *----------------------------------*}

    PROCEDURE Stop(msg: Str255);
    BEGIN                                                          {Stop}
        IF Length(msg) > 0 THEN
            BEGIN
                PLFlush (Output);
                WriteLn(Diagnostic);
                WriteLn(Diagnostic, msg);
            END;

        IF interrupted THEN retCode := RC_Abort;
        {don't worry about closing the files we opened.  The Shell
            will do so if appropriate.}
        IEexit(Ord(retCode));            {exit, returning the appropriate status code}
    END;        {Stop}

    {*--------------------------------------*
    | Intr - Process external interrupt        |
    | this routine is passed to IEsigset    |
    *--------------------------------------*}

    PROCEDURE Intr;
    BEGIN         {Intr}
        interrupted := True;                {we test this switch periodically}
    END;        {Intr}

    {$S Init}

    {*-------------------------------------------------------------*
     | SyntaxError - Report an error in parameters or options        |
     *-------------------------------------------------------------*}

    PROCEDURE SyntaxError(suffix: Str255);
    BEGIN        {SyntaxError}
        PLFlush (Output);
        WriteLn(Diagnostic, '### ', progName, ' - ', suffix);
        Stop(Concat('# Usage: ', progName, ' file1 file2'));
    END;        {SyntaxError}

    {*--------------------------------------*
     | LetterOpt - Set a letter option        |
     *-------------------------------------*}

    PROCEDURE LetterOpt(opt: Char; VAR argVIndex: integer);
        {note no options are supported; argVIndex is passed to
             this routine so options that have arguments can 'eat' them}
    BEGIN        {LetterOpt}
        SyntaxError(Concat(ArgV^[argVIndex]^, ' <invalid option>'));
    END;        {LetterOpt}

    {*---------------------------*
    | Init - Tool initalization |
    *---------------------------*}

    PROCEDURE Init;
    VAR
        ioRslt:                INTEGER;
        argVIndex:            INTEGER;
        fileCount:            INTEGER;
        holdIndex:            INTEGER;
        prevSig:             SignalHandler;
        strH:                StringHandle;
        nextFileNamePtr:    StringPtr;
        arg:                Str255;
        p:                    LongPtr;
    BEGIN        {Init}
        retCode := RC_Normal;

        addSpace := TRUE;

        interrupted := False;                      {becomes True when interrupted}
        prevSig := IEsignal(SIGINT, @Intr);

        quiet := True;
        progName := ArgV^[0]^;

        fileCount := 0;
        retCode := RC_ParmErrs;
        argVIndex := 1;

        WHILE argVIndex < ArgC DO                     {ArgC is the number of args plus one}
            BEGIN
                arg := ArgV^[argVIndex]^;
                IF (Length(arg) <> 0) THEN
                    BEGIN
                        IF arg[1] = '-' THEN            {we have an option }
                            BEGIN
                                holdIndex := argVIndex;
                                LetterOpt(arg[2], argVIndex);
                                IF argVIndex <> holdIndex THEN
                                    CYCLE;                 {skip the increment of argVIndex below}
                            END
                        ELSE                            {it must be a file to open}
                            BEGIN
                                fileCount := fileCount + 1;
                                IF fileCount = 1 THEN
                                    nextFileNamePtr := @textName
                                ELSE
                                    nextFileNamePtr := @realName;

                                nextFileNamePtr^ := ArgV^[argVIndex]^;
                            END;
                    END;
                argVIndex := argVIndex + 1;
            END;

        IF fileCount <> 2 THEN
                SyntaxError('Invalid Parameters');

        Open (textCookies, textName);
        IF Eof (textCookies) OR (IOResult <> 0) THEN
            Stop(Concat('### ', progName, ' - ', 'could not open ', textName));

        Rewrite (realCookies, realName);
        IF IOResult <> 0 THEN
            Stop(Concat('### ', progName, ' - ', 'could not open ', realName));

        Open (tempCookies, 'TttempCookies');
        IF IOResult <> 0 THEN
            Stop( Concat ('### ', progName, ' - ', 'could not open TttempCookies'));

        IF NOT quiet THEN
            BEGIN
                WriteLn(Diagnostic);
                WriteLn(Diagnostic, progName, '  (Ver ', Version, ') ');
                WriteLn(Diagnostic);
                WriteLn(Diagnostic);
            END;

        retCode := RC_Abort;

        cookieBuffer := NewHandle (kCookieSize);
        theOffsets := NewHandle (kOffsetSize);

        IF (cookieBuffer = NIL) OR (theOffsets = NIL) THEN
            Stop (Concat ('### ', progName, ' - ', 'could not allocate memory'));

        retCode := RC_Normal;

        textLen := 0;
        bufLen := 0;
        numCookies := 0;

        {Put a zero as first offset}
        HLock (theOffsets);
        p := LongPtr (theOffsets^);
        p^ := textLen;
        HUnlock (theOffsets);

        RotateCursor(0);
        IF interrupted THEN Stop('');
    END;        {Init}

    {$S Main}
    {*---------------------------------------------*
     | BufferToText -- add the buffer to the text  |
     *---------------------------------------------*}
    PROCEDURE BufferToText;
    VAR
        i:        INTEGER;
        p:        LongPtr;
    BEGIN
        {add one to the number of cookies}
        numCookies := numCookies + 1;

        HLock (cookieBuffer);

        i := ByteWrite (tempCookies, cookieBuffer^^, bufLen);
        textLen := textLen + bufLen;
        bufLen := 0;

        HUnlock (cookieBuffer);

        {Put offset to next cookie}
        HLock (theOffsets);
        p := LongPtr (Ord4 (theOffsets^) + (numCookies * SizeOf (LONGINT)));
        p^ := textLen;
        HUnlock (theOffsets);
    END;

    {*--------------------------------------------------------*
     | AlphaNum -- returns TRUE if character is alphanumeric  |
     *--------------------------------------------------------*}
     FUNCTION AlphaNum (c: CHAR):    BOOLEAN;
     BEGIN
         IF ((c >= '0') AND (c <= '9')) OR
                    ((c >= 'A') AND (c <= 'Z')) OR
                    ((c >= 'a') AND (c <= 'z')) THEN
            AlphaNum := TRUE
        ELSE
            AlphaNum := FALSE;
    END;


    {*--------------------------------------------------*
     | AddToBuffer -- add a string to the cookie buffer |
     *--------------------------------------------------*}
     PROCEDURE AddToBuffer (s: Str255);
     VAR
         ch:        CHAR;
     BEGIN
        IF bufLen > 0 THEN                {Don't do this the first time}
            BEGIN
                IF AlphaNum (s[1]) THEN
                    BEGIN
                        IF addSpace THEN
                            BEGIN
                                s := Concat (' ', s)
                            END
                        ELSE
                            BEGIN
                                addSpace := TRUE;
                            END;
                    END
                ELSE
                    BEGIN
                        IF s = '$$' THEN    {Skip a line}
                            BEGIN
                                s := Concat (Chr (13), Chr (13));
                                addSpace := FALSE;
                            END
                        ELSE IF s = '!!' THEN    {Put in a return}
                            BEGIN
                                s := Chr (13);
                                addSpace := FALSE;
                            END
                        ELSE
                            BEGIN            {Add return then string}
                                IF addSpace THEN
                                    BEGIN
                                        s := Concat (Chr (13), s);
                                    END;
                                addSpace := TRUE;
                            END;
                    END;
            END;

         HLock (cookieBuffer);
        BlockMove (Ptr (Ord4 (@s) + 1), Ptr (Ord4 (cookieBuffer^) + bufLen),
                    LENGTH (s));

        bufLen := bufLen + LENGTH (s);
        HUnlock (cookieBuffer);
    END;


    {*------------------------------------------------------*
     | WriteCookieFile -- write the formatted data to disk    |
     *------------------------------------------------------*}
     PROCEDURE WriteCookieFile;
    VAR
        i:        LONGINT;        {dummy variable}
        p:        LongPtr;
        b:        ARRAY [0..511] OF Byte;        {A basic 512 byte buffer}
        n, tL:    LONGINT;
    BEGIN
         {Write number of cookies}
        p := @numCookies;
         i := ByteWrite (realCookies, numCookies, SizeOf (LONGINT));

        {Write offset array}
        HLock (theOffsets);
        i := ByteWrite (realCookies, theOffsets^^, (numCookies + 1) * SizeOf (LONGINT));
        HUnlock (theOffsets);

        {Write the text info}
        Seek (tempCookies, 0);    {Go back to beginning}

        tL := textLen;
        n := 512;                {Transfer data in 512 byte chunks}
        WHILE tL > 0 DO
            BEGIN
                IF textLen < 512 THEN n := tL;
                i := ByteRead (tempCookies, b, n);
                tL := tL - i;
                i := ByteWrite (realCookies, b, i);

                SpinCursor (-1);
            END;

      {    Report on the number of cookies baked}
        WriteLn ('Number of cookies baked: ', numCookies);
        WriteLn ('Total filelength: ', textLen + ((numCookies + 1)
                        * SizeOf (LONGINT)));
    END;


    {*-------------------------------*
     | DoIt -- actually fix cookies  |
     *-------------------------------*}
    PROCEDURE DoIt;
    VAR
        n:            LONGINT;        {Number of cookies}
        i:            LONGINT;        {Cookie currently processing}
        s:            Str255;            {Current line of text}
    BEGIN
        WHILE NOT Eof (textCookies) DO
            BEGIN
                ReadLn (textCookies, s);
                IF IOResult <> 0 THEN
                    Stop (Concat ('### ', progName, ' - ',
                        'problems reading file'));

                IF s = '%%' THEN
                    BEGIN
                        BufferToText;
                        addSpace := TRUE;
                    END
                ELSE
                    BEGIN
                        AddToBuffer (s);
                    END;

                SpinCursor (1);
            END;

        WriteCookieFile;

        Close (realCookies);            {Close files nicely}
        Close (textCookies);
        Close (tempCookies);

        PLPurge ('TttempCookies');        {Delete this file}

        DisposHandle (theOffsets);        {Dispose of handles used}
        DisposHandle (cookieBuffer);
    END;


{*-----------------------*
 | Bake -- main program  |
 *-----------------------*}

BEGIN        {Bake}
    Init;                    { sets up world, opens our resource files}
    UnLoadSeg(@Init);         { release our initialization segment}
    DoIt;                     { and call our routine}
END.        {Bake}